home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #02 (Apr85-Jul85) / modula 2 / modula Vol. 1 #7 / HanoiGraphic.MOD
Text File  |  1985-04-14  |  4KB  |  138 lines
  1. MODULE Hanoi;
  2.    (* build starting position for Hanoi Towers *)
  3.  
  4.    FROM Terminal IMPORT ClearScreen;
  5.    FROM InOut IMPORT WriteString, ReadCard, WriteLn;
  6.   
  7.    (* data structures for Quickdraw calls *)
  8.    TYPE 
  9.       VHSelect = (v,h);
  10.       
  11.       Point = RECORD
  12.                  CASE INTEGER OF
  13.             0: v: INTEGER;
  14.                h: INTEGER;
  15.                
  16.            |1: vh: ARRAY VHSelect OF INTEGER;
  17.          END; (* CASE *)
  18.           END; (* RECORD *)
  19.           
  20.       Rect = RECORD
  21.                 CASE INTEGER OF
  22.            0: top: INTEGER;
  23.               left: INTEGER;
  24.               bottom: INTEGER;
  25.               right: INTEGER;
  26.               
  27.           |1: topLeft: Point;
  28.               botRight: Point;
  29.          END; (* CASE *)
  30.               END; (* RECORD *)
  31.           
  32.    CONST
  33.      CX = 355B;
  34.      QuickDraw1ModNum = 2; (* absolute module number 
  35.                      of QuickDraw1 *)
  36.    VAR
  37.       r: Rect; NumDisks: CARDINAL;
  38.       
  39.    PROCEDURE SetRect (VAR r: Rect; left,top,right,bottom: INTEGER);
  40.       CODE CX; QuickDraw1ModNum; 51 END SetRect;
  41.    
  42.    PROCEDURE PaintRect  (r: Rect);
  43.       CODE CX; QuickDraw1ModNum; 62 END PaintRect;
  44.    
  45.    PROCEDURE PaintRoundRect(r: Rect; ovWd, ovHt: INTEGER);
  46.       CODE CX; QuickDraw1ModNum; 67 END PaintRoundRect;
  47.    
  48.    PROCEDURE DrawBase;
  49.       CONST 
  50.      BaseLeft = 36;
  51.      BaseTop = 261;
  52.      BaseRight = 476;
  53.      BaseBottom = 270;
  54.    BEGIN 
  55.       SetRect(r,BaseLeft,BaseTop,BaseRight,BaseBottom);
  56.       PaintRect(r);
  57.    END DrawBase;
  58.    
  59.    PROCEDURE DrawPosts;
  60.       CONST
  61.          PostTop = 144;
  62.      PostBottom = 261;
  63.      PostWidth = 6;
  64.      HalfPostWidth = PostWidth DIV 2;
  65.      PostPosition = 128;
  66.       VAR
  67.          n, PostLeft, PostRight: INTEGER;
  68.    BEGIN
  69.       n:=1;
  70.       WHILE n <= 3 DO
  71.      PostLeft := (PostPosition * n) - HalfPostWidth;
  72.      PostRight := PostLeft + PostWidth;
  73.      SetRect(r,PostLeft,PostTop,PostRight,PostBottom);
  74.      PaintRect(r);
  75.      n:= n + 1;
  76.       END; (* WHILE *)
  77.    END DrawPosts;
  78.    
  79.    PROCEDURE DrawVarDisks(numberofdisks: CARDINAL);
  80.       CONST
  81.          bigdiskleft = 128 - 60;
  82.      bigdisktop = 261 - 12;
  83.      bigdiskright = 128 + 60;
  84.      bigdiskbottom = 261;
  85.      deltalength = 5;
  86.      deltadepth = 12;
  87.       VAR leftedge, topedge, rightedge, bottomedge: INTEGER;
  88.           i: CARDINAL;
  89.    BEGIN
  90.       IF (numberofdisks > 2) AND (numberofdisks < 10)
  91.          THEN
  92.         leftedge := bigdiskleft; topedge := bigdisktop;
  93.         rightedge := bigdiskright; bottomedge := bigdiskbottom;
  94.         SetRect(r,leftedge,topedge,rightedge,bottomedge);
  95.         PaintRoundRect(r,40,40);
  96.         FOR i := 1 TO numberofdisks - 1 DO
  97.            leftedge := leftedge + deltalength;
  98.            topedge := topedge - deltadepth;
  99.            rightedge := rightedge - deltalength;
  100.            bottomedge := bottomedge - deltadepth;
  101.            SetRect(r,leftedge,topedge,rightedge,bottomedge);
  102.            PaintRoundRect(r,40,40);
  103.         END; (* FOR *)
  104.      END; (* IF *)
  105.    END DrawVarDisks;
  106.    
  107.    PROCEDURE GetInput(VAR NDisks: CARDINAL);
  108.    BEGIN
  109.       ClearScreen;
  110.       WriteString("Enter number of disks (between 3 to 9)");
  111.       WriteLn;
  112.       WriteString("To quit - enter number out of range");
  113.       ReadCard(NDisks);
  114.       ClearScreen;
  115.    END GetInput;
  116.    
  117.    PROCEDURE InitGraphics(NumberofDisks: CARDINAL);
  118.    BEGIN
  119.       DrawBase;
  120.       DrawPosts;
  121.       DrawVarDisks(NumberofDisks);
  122.    END InitGraphics;
  123.    
  124.    PROCEDURE ExecuteTowers;
  125.    VAR Delay: CARDINAL;
  126.    BEGIN
  127.       FOR Delay := 1 TO 30000 DO  END; (* FOR *)
  128.    END ExecuteTowers;
  129.    
  130. BEGIN
  131.    GetInput(NumDisks);
  132.    WHILE (NumDisks >= 3) AND (NumDisks <= 9) DO
  133.       InitGraphics(NumDisks);
  134.       ExecuteTowers;
  135.       GetInput(NumDisks);
  136.    END; (* WHILE *)
  137. END Hanoi.
  138.